C/C++ Users Group Library 1996 July

home *** CD-ROM | disk | FTP | other *** search

/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_100 / 196_01 / fp128.csm < prev next >

Wrap

Text File | 1985-11-13 | 20KB | 1,403 lines

;/* ;***************************************************************** ;* Written by : Hakuo Katayose (JUG-CP/M No.179) * ;* JIP 980 * ;* 49-114 kawauchi-Sanjuunin-machi * ;* Sendai, Miyagi, Japan. * ;* Telph.No (0222)61-3219 * ;* Edited by : * ;* * ;***************************************************************** ;*/ ; INCLUDE "BDS.LIB" BIASEXP EQU 0400H NBYTES EQU 16 ; ;-------------------------------------------------------------- ;-------------------------------------------------------------- ; ; 128_bit floting opration result flags. ; ; EP 1 byte length. ; OUTSGN 1 byte length. ; OUTBUF 48 byte length. ; ; OVF 1 byte length. ; UNF 1 byte length. ; ZERO 1 byte length. ; MINUS 1 byte length. ; ;-------------------------------------------------------------- ; ; 128_bit floting work_registers. ; ; TEMPW nbytes+5 byte length. ; ; UU nbytes byte length. ; VV nbytes byte length. ; WW nbytes byte length. ; XX nbytes byte length. ; YY nbytes byte length. ; ;-------------------------------------------------------------- ; ; 128_bit floting Acc registers. ; ; LA 128_bit floting ACC_A. A_Acc extention. ; AREG 128_bit floting ACC_A. A_Acc. ; AEXP 128_bit floting ACC_A. expornemt. ; ASIGN 128_bit floting ACC_A. sign_flag. ; ; LB 128_bit floting ACC_B. B_Acc extention. ; BREG 128_bit floting ACC_B. B_Acc. ; BEXP 128_bit floting ACC_B. expornemt. ; BSIGN 128_bit floting ACC_B. sign_flag. ; ; TEN1 128_bit floting constant. 10.0 ; ONE 128_bit floting constant. 1.0 ; TENM1 128_bit floting constant. 0.1 ; NUM0 128_bit floting constant. 0.0 ; ; ; ; FUNCTION fp128 call arghak push b lda arg1 ora a jz FPTEST cpi 11 jz FPIN cpi 255 jz FPTST2 lhld arg2 xchg lxi h,AREG call unpack ; (arg2) --> Acc. (Unpack). lda arg1 cpi 10 jz FPCONV lhld arg3 xchg lxi h,BREG call unpack ; (arg2) --> Bcc. (Unpack). lxi h,exitp push h lda arg1 cpi 1 jz FPMUL0 cpi 2 jz FPDIV0 cpi 3 jz FPADD0 cpi 4 jz FPSUB0 pop h pop b lxi h,0 ret exitp: lhld arg4 xchg call pack lxi h,OVF xra a ora m inx h ora m inx h ora m inx h ora m mov l,a mvi h,0 pop b ret ; ;-------------------------------------------------------------- ; FLOATING POINT DIVIDE ------ Acc = Acc / Bcc. ;-------------------------------------------------------------- FPDIV0: lxi h,0 shld OVF shld ZERO lhld BEXP mov a,h ora l jz ovrfw lhld AEXP mov a,h ora l jz setzero ; fdiv1: lxi h,0 shld LA shld LA+2 shld LA+4 shld LA+6 lxi h,LA+NBYTES+NBYTES-1 mvi b,NBYTES+1 xra a call sftr0 lxi h,BREG+NBYTES-1 xra a call sftr lhld BEXP inx h shld BEXP mvi b,NBYTES*8 fdiv2: push b lxi d,AREG+NBYTES-1 lxi h,BREG+NBYTES-1 call icmp ; comp Acc - Bcc. jc fdiv3 ; if Acc < Bcc then fdiv3. lxi d,AREG lxi h,BREG call isub ; Acc = Acc - Bcc. xra a fdiv3: cmc lxi h,LA call sftl call sftl pop b ; djnz fdiv2 db 010h,0dch lxi h,LA lxi d,AREG lxi b,NBYTES ldir lhld AEXP lxi d,BIASEXP+2 dad d xchg lhld BEXP xchg jmp expnrm ; ;-------------------------------------------------------------- ; FLOATING POINT MULTIPLY ------ Acc = Acc * Bcc. ;-------------------------------------------------------------- ; FPMUL0: lxi h,0 shld OVF shld ZERO lhld BEXP mov a,h ora l jz setzero lhld AEXP mov a,h ora l jz setzero ; fmul3: lxi h,AREG lxi d,LA lxi b,nbytes ldir lxi h,BREG call imul lhld AEXP xchg lhld BEXP dad d lxi d,BIASEXP expnrm: ora a dsbc d shld AEXP jc undrfw mov a,h cpi BIASEXP/128 jnc ovrfw lda ASIGN lxi h,BSIGN xra m sta ASIGN jmp fpnorm ; ;-------------------------------------------------------------- ; FLOATING POINT ADDITION Acc = Acc + Bcc. ; FLOATING POINT SUBTRACT Acc = Acc - Bcc. ;-------------------------------------------------------------- ; FPSUB0: lda BSIGN xri 080h sta BSIGN ; FPADD0: lxi h,0 shld OVF shld ZERO lhld AEXP mov a,h ora l xchg jnz fadd1 lxi h,BREG lxi d,AREG lxi b,NBYTES+3 ldir jmp fpnorm fadd1: lhld BEXP mov a,h ora l jz fpnorm xchg dsbc d jz fadd4 jnc fadd2 lda ASIGN ; Acc_flag <--> Bcc_flag. mov c,a lda BSIGN sta ASIGN mov a,c sta BSIGN lxi h,AREG lxi d,BREG mvi b,nbytes+2 call swap0 shld BEXP xchg shld AEXP ora a dsbc d fadd2: mov a,h ora a jnz fpnorm mov a,l cpi NBYTES*8-1 jnc fpnorm mov b,a lhld BEXP xchg fadd3: push b xra a lxi h,BREG+NBYTES-1 call sftr inx d pop b ; djnz fadd3 db 010h,0f4h fadd4: xchg shld BEXP lda ASIGN lxi h,BSIGN xra m jnz fadd5 ; ; if same sign. ; lxi d,AREG lxi h,BREG call iadd ; (Acc) = (Acc) + (Bcc). jnc fpnorm lxi h,AREG+NBYTES-1 ; if carry_flag set then, call sftr ; shift right lhld AEXP inx h shld AEXP ; & exp = exp + 1. jmp fpnorm ; ; if different sign. ; fadd5: lxi d,AREG lxi h,BREG call isub ; Acc = Acc - Bcc. jnc fpnorm lxi h,AREG call ineg ; negate Acc. lda BSIGN sta ASIGN ; Asign = Bsign. call fpnorm ret ; ;-------------------------------------------------------------- ; UNPACK (DE) -> (HL). ;-------------------------------------------------------------- ; UNPACK: xra a mov m,a inx h push h xchg lxi b,NBYTES ldir pop h xra a mvi b,nbytes unpck1: rld inx h ; djnz unpck1 db 010h,0fbh mov c,a ani 00000111b mov m,a mov a,c ani 00001000b jz unpck2 mvi a,080h unpck2: inx h mov m,a ret ; ;-------------------------------------------------------------- ; PACK SOURCE = A REG , DESTINATION = DE. ;-------------------------------------------------------------- ; pack: push d lxi h,OVF mov a,m ; OVF inx h ora m ; UNF inx h ora m ; ZERO jnz pack1 lxi h,AREG+1 mov a,m ani 08h cnz inca pack1: lda ASIGN ora a mvi c,0 jz pack2 mvi c,08h pack2: lda AEXP+1 ani 00000111b ora c lxi h,AEXP mvi b,nbytes pack3: rrd dcx h ; djnz pack3 db 010h,0fbh inx h pop d lxi b,NBYTES ldir RET ; ; ; INCREMENT A AND CORRECT FORM. ; inca: mov a,m ani 0f8h adi 08h mov m,a rnc mvi b,NBYTES-2 inca1: inx h inr m rnz ; djnz inca1 db 010h,0fbh stc call sftr lhld AEXP inx h shld AEXP mov a,h cpi BIASEXP/128 rc mvi h,BIASEXP/128-1 shld AEXP mvi a,08h sta OVF ret ; ;-------------------------------------------------------------- ; FLOTING NUMBER OUTPUT CONVERTION. ;-------------------------------------------------------------- ; FPCONV: lda ASIGN ora a mvi a,' ' jz conv1 mvi a,'-' conv1: sta outsgn lhld AEXP mov a,h ora l jz conv9 xra a sta ASIGN lxi h,0 shld EP ; EP = 0; conv20: lxi h,256 shld k2 ; k2 = 256; conv2: lxi d,AREG+NBYTES+1 lxi h,ONE +NBYTES+1 mvi b,nbytes+2 call icmp0 jc mconv ; if (A < 1.0) then mconv. lxi h,TEN256 ; T = TEN256; shld T ; pconv1: lxi d,NBYTES+1 dad d lxi d,AREG+NBYTES+1 mvi b,nbytes+2 call icmp0 jc pconv2 ; if (A < *T) then pconv2 lhld T ; A = A / *T; lxi d,BREG lxi b,NBYTES+3 ldir call FPDIV0; lhld k2 ; EP = EP + k2; xchg lhld EP dad d shld EP ; } pconv2: lhld k2 srlr h rarr l ; k2 = k2 / 2; shld k2 mov a,h ora l jz conv3 lhld T lxi d,nbytes+3 dad d shld T ; T = T + NBYTES+3; jmp pconv1 ; } ; ; ; mconv: lxi d,AREG+nbytes+1 lxi h,TENM1+nbytes+1 mvi b,nbytes+2 call icmp0 jnc conv3 ; if (A >= 0.1) then conv3 lxi h,TENM128 ; T = 10**(-128); shld T lxi d,AREG+NBYTES+1 lxi h,TENM256+NBYTES+1 mvi b,nbytes+2 call icmp0 jnc mconv1 ; if (A >= *T) then mconv2 lxi h,TEN256 lxi d,BREG lxi b,NBYTES+3 ldir call FPMUL0; lxi h,TEN256 lxi d,BREG lxi b,NBYTES+3 ldir call FPMUL0; lxi h,-512 shld EP jmp conv20 mconv1: lhld T lxi d,nbytes+1 dad d lxi d,AREG+NBYTES+1 mvi b,nbytes+2 call icmp0 jc mconv2 ; if (A <